home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / System.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-25  |  31.6 KB  |  835 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. InfoElems
  3. Alloc
  4. Syntax10.Scn.Fnt
  5. StampElems
  6. Alloc
  7. 25 Jan 96
  8. "Title": 
  9. "Author": 
  10. "Abstract": 
  11. "Keywords": 
  12. "Version": 
  13. "From":  27.06.95 13:41:44
  14. "Until": S
  15. "Changes": 
  16.     27.6.95    mah    Finalize in System.Quit
  17.     22.9.95    mah    Error in HomeDir corrected
  18. Syntax10i.Scn.Fnt
  19. Syntax12.Scn.Fnt
  20. Syntax10b.Scn.Fnt
  21. MODULE System; (*JG 25.4.90, NW 22.4.90, JT 7.5.90 / 21.01.93, RC 2.6.91, MB 21.6.91 / 13.10.93 *)
  22.     IMPORT
  23.         SYSTEM, Sys, Kernel, Modules, Files, Input, Display, Macintosh, Directories,
  24.         Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames, Strings;
  25.     CONST
  26.         StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store ";
  27.         LogMenu = "System.Close System.Grow Edit.Locate Edit.Store ";
  28.         VersionString = "PowerMac Oberon V4 (TM) 1.4";
  29.         dateOpt = 1; sizeOpt = 2; allPaths = 3; (* Directory Options *)
  30.         (* structure forms *)
  31.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  32.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  33.         Pointer = 13; ProcTyp = 14; Comp = 15;
  34.         (* special registers *)
  35.         SP = 1; SB = 2; FP = 31;
  36.         (* register modes *)
  37.         Reg = 16; FReg = 18; Cond = 19;
  38.         T: Texts.Text; W: Texts.Writer;
  39.         trap, t, d: LONGINT;
  40.         options: SET;    (*options in System.Directory*)
  41.         pattern: ARRAY 256 OF CHAR;    (*search pattern in System.Directory*)
  42.         startupDone, fullPath: BOOLEAN;
  43.         OldTrap: Sys.ExceptionHandler;
  44.     PROCEDURE ReadInt (VAR i: LONGINT; VAR pos: LONGINT);
  45.         VAR n: LONGINT; s: SHORTINT; x: CHAR;
  46.     BEGIN
  47.         s := 0; n := 0; SYSTEM.GET(pos, x); INC(pos);
  48.         WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); SYSTEM.GET(pos, x); INC(pos) END;
  49.         i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s)
  50.     END ReadInt;
  51.     PROCEDURE WriteVariable (adr, form: LONGINT; regalloc: BOOLEAN);
  52.         VAR ch: CHAR; si: SHORTINT; i: INTEGER; li: LONGINT; r: REAL; lr: LONGREAL;
  53.     BEGIN
  54.         IF regalloc & (form IN {Byte, Bool, Char}) THEN INC(adr, 3) END;
  55.         SYSTEM.GET(adr, li);
  56.         CASE form OF
  57.             Byte: SYSTEM.GET(adr, ch); Texts.WriteHex(W, ORD(ch)); Texts.Write(W, "H")
  58.         |  Char: SYSTEM.GET(adr, ch);
  59.                 IF (" " < ch) & (ch <= "z") THEN Texts.Write(W, 22X); Texts.Write(W, ch); Texts.Write(W, 22X)
  60.                 ELSE Texts.WriteHex(W, ORD(ch)); Texts.Write(W, "X")
  61.                 END
  62.         |  Bool: SYSTEM.GET(adr, ch);
  63.                 IF ch # 0X THEN Texts.WriteString(W, "TRUE") ELSE Texts.WriteString(W, "FALSE") END
  64.         |  SInt:
  65.                 IF ~regalloc THEN SYSTEM.GET(adr, si); Texts.WriteInt(W, si, 0) ELSE Texts.WriteInt(W, li, 0) END
  66.         |  Int:
  67.                 IF ~regalloc THEN SYSTEM.GET(adr, i); Texts.WriteInt(W, i, 0) ELSE Texts.WriteInt(W, li, 0) END
  68.         |  LInt: Texts.WriteInt(W, li, 0)
  69.         |  Real: IF regalloc THEN SYSTEM.GET(adr, lr); r := SHORT(lr) ELSE SYSTEM.GET(adr, r) END; 
  70.                 Texts.WriteReal(W, r, 16)
  71.         |  LReal: SYSTEM.GET(adr, lr); Texts.WriteLongReal(W, lr, 24)
  72.         |  Set, Pointer: Texts.WriteHex(W, li); Texts.Write(W, "H")
  73.         |  Comp:
  74.                 i := 1; SYSTEM.GET(adr, ch); Texts.Write(W, 22X);
  75.                 WHILE (i < 32) & (ch # 0X) DO Texts.Write(W, ch); SYSTEM.GET(adr+i, ch); INC(i) END;
  76.                 Texts.Write(W, 22X)
  77.         ELSE Texts.WriteString(W, "invalid form")
  78.         END
  79.     END WriteVariable;
  80.     PROCEDURE OverReadTypes (VAR pos: LONGINT; VAR form: SHORTINT);   (* MK *)
  81.         VAR n: LONGINT; si: SHORTINT; ch: CHAR;
  82.     BEGIN
  83.         SYSTEM.GET (pos, form); SYSTEM.GET (pos, ch); INC (pos);
  84.         IF ch = CHR (ProcTyp) THEN ReadInt (n, pos)    
  85.         ELSIF ch = 0FX THEN ReadInt (n, pos); ReadInt (n, pos); OverReadTypes (pos, si)
  86.         ELSIF ch = 10X THEN INC (pos); ReadInt (n, pos)
  87.         ELSIF ch = 11X THEN ReadInt (n, pos); OverReadTypes (pos, si)
  88.         ELSIF ch = CHR (Pointer) THEN OverReadTypes (pos, si)
  89.         END
  90.     END OverReadTypes;
  91.     PROCEDURE Locals (VAR info: Sys.ExceptionInfoDesc; VAR ref: LONGINT; refend, base: LONGINT);
  92.         VAR
  93.             pos, adr, mode: LONGINT;
  94.             ch, VarFlag: CHAR;
  95.             form: SHORTINT;
  96.             name: ARRAY 256 OF CHAR; i: INTEGER;
  97.     BEGIN
  98.         pos := ref; SYSTEM.GET(pos, VarFlag); INC(pos); Texts.WriteLn(W);
  99.         WHILE (pos < refend) & (VarFlag # 0F8X) & (VarFlag # 0F7X) DO
  100.             i := 0;
  101.             REPEAT
  102.                 SYSTEM.GET(pos, ch); INC(pos);
  103.                 name[i] := ch; INC (i)
  104.             UNTIL (ch = 0X) OR (pos >= refend);
  105.             ReadInt(adr, pos);
  106.             OverReadTypes (pos, form);
  107.             IF (form <= 31) & (form >= 0) & (form IN {Byte, Char, Bool, SInt, Int, LInt, Real, LReal, Set, Pointer, Comp}) THEN
  108.                 Texts.Write (W, 9X); Texts.WriteString (W, name); Texts.WriteString(W, " = ");
  109.                 IF adr < 0 THEN
  110.                     adr := -1-adr; mode := adr DIV 32; adr := adr MOD 32;
  111.                     IF VarFlag = 3X THEN
  112.                         IF mode # Reg THEN Texts.WriteString(W, "VarPar in register other than reg.R "); Texts.WriteLn(W) END;
  113.                         WriteVariable(info.reg.R[2*adr+1], form, FALSE)
  114.                     ELSE
  115.                         IF mode = Reg THEN WriteVariable(SYSTEM.ADR(info.reg.R[2*adr+1]), form, TRUE)
  116.                         ELSIF mode = FReg THEN WriteVariable(SYSTEM.ADR(info.fp.R[2*adr]), form, TRUE)
  117.                         ELSIF adr IN SYSTEM.VAL(SET, info.spec.CR) THEN Texts.WriteString(W, "TRUE")
  118.                         ELSE Texts.WriteString(W, "FALSE")
  119.                         END
  120.                     END
  121.                 ELSE
  122.                     WriteVariable(adr+base, form, FALSE)
  123.                 END;  
  124.                 Texts.WriteLn(W)
  125.             END;
  126.             SYSTEM.GET (pos, VarFlag); INC (pos)
  127.         END;
  128.         ref := pos-1
  129.     END Locals;
  130.     PROCEDURE FindProc (pc: LONGINT; VAR mod: Modules.Module; VAR refpos, refend: LONGINT);
  131.         VAR m: Modules.Module; ref, p: LONGINT; ch: CHAR;
  132.     BEGIN
  133.         m := Modules.modules; mod := NIL; refpos := -1;
  134.         WHILE (m # NIL) & ((pc < m^.PC) OR (m^.PC+m^.codesize*4 < pc)) DO m := m^.link END;
  135.         IF m # NIL THEN mod := m;
  136.             pc := (pc - m^.PC) DIV 4;
  137.             ref := m^.refs; refend := ref; p := 0;
  138.             IF mod^.refs # 0 THEN INC(refend, m^.refsize) END;
  139.             LOOP
  140.                 IF ref >= refend THEN EXIT END;
  141.                 SYSTEM.GET(ref, ch); INC(ref);
  142.                 IF ch = 0F8X THEN
  143.                     ReadInt(p, ref);
  144.                     IF p >= pc THEN refpos := ref; EXIT END
  145.                 END
  146.             END
  147.         END
  148.     END FindProc;
  149.     PROCEDURE FindTrapClass (mod: Modules.Module; pc: LONGINT; VAR p: LONGINT);
  150.         VAR pos, len: LONGINT; trap : Modules.TrapDescPtr; 
  151.     BEGIN
  152.         pc := (pc - mod^.PC) DIV 4; p := 256;
  153.         pos := 0; len := 0; IF mod^.traps # 0 THEN len := mod^.noftraps END;
  154.         trap:= SYSTEM.VAL (Modules.TrapDescPtr, mod.traps);
  155.         WHILE (pos < len) & (pc # trap.offset) DO
  156.             INC(pos);
  157.             trap:=SYSTEM.VAL (Modules.TrapDescPtr, SYSTEM.VAL (LONGINT, trap)+4);
  158.         END;
  159.         IF pos < len THEN p := trap.trapno END
  160.     END FindTrapClass;
  161.     PROCEDURE Trap (info: Sys.ExceptionInfo) : LONGINT;
  162.         VAR
  163.             V: Viewers.Viewer;
  164.             mod: Modules.Module;
  165.             ch: CHAR;
  166.             pc, sp, ref, refend, p, fsize, psize, ralloc, falloc, calloc, nofFrames, stackBottom: LONGINT;
  167.             X, Y: INTEGER;
  168.             leaf, body, first: BOOLEAN;
  169.             cur : Sys.ExceptionInfoDesc;
  170.     BEGIN
  171.         cur:=info^;
  172.         IF cur.spec.PC = Macintosh.kbdIntPC THEN
  173.             SYSTEM.PUT (Macintosh.kbdIntPC, Macintosh.kbdIntInstr);    (* restore patched code *)
  174.             Macintosh.kbdIntPC := 0
  175.         END;
  176.         IF trap < 2 THEN
  177.             INC(trap);
  178.             IF trap > 1 THEN
  179.                 (* recursive trap ???? No console, so do nothing *)
  180.                 Texts.WriteString(W, "Recursive trap "); Texts.WriteLn(W); Texts.Append (T, W.buf); DEC (trap);
  181.             END;
  182.             T := TextFrames.Text("");
  183.             Oberon.AllocateSystemViewer(0, X, Y);
  184.             V := MenuViewers.New(
  185.                 TextFrames.NewMenu("System.Trap", StandardMenu),
  186.                 TextFrames.NewText(T, 0),
  187.                 TextFrames.menuH,
  188.                 X, Y);
  189.             IF V.state > 0 THEN
  190.                 IF trap > 1 THEN Texts.WriteString(W, "*** recursive trap"); Texts.WriteLn(W); DEC (trap) END;
  191.                 pc := cur.spec.PC; sp := cur.reg.R[2*1+1];
  192.                 Texts.WriteString(W, "Trap "); Texts.WriteInt(W, cur.kind, 0);
  193.                 IF pc = 0 THEN
  194.                     Texts.WriteString(W, " (NIL procedure called)");
  195.                     pc := cur.spec.LR
  196.                 ELSE
  197.                     CASE cur.kind OF
  198.                         0: Texts.WriteString(W, " (Unknown exception)")
  199.                     |   1: Texts.WriteString(W, " (Illegal instruction)")
  200.                     |   2: FindProc(pc, mod, ref, refend); IF mod # NIL THEN FindTrapClass(mod, pc, p) ELSE p := 256 END;
  201.                             IF p > 255 THEN Texts.WriteString(W, " (Breakpoint)")
  202.                             ELSE 
  203.                                 Texts.Write(W, "."); Texts.WriteInt(W, p, 0);
  204.                                 CASE p OF
  205.                                     0: Texts.WriteString(W, " (ASSERT failed)")
  206.                                 |   1: Texts.WriteString(W, " (Index out of range)")
  207.                                 |   2: Texts.WriteString(W, " (Integer division by value <= 0)")
  208.                                 |   3: Texts.WriteString(W, " (Invalid case in CASE statement)")
  209.                                 |   4: Texts.WriteString(W, " (Type guard check)")
  210.                                 |   5: Texts.WriteString(W, " (Function procedure without RETURN statement)")
  211.                                 |   6: Texts.WriteString(W, " (Invalid array dimension in NEW)")
  212.                                 |   7: Texts.WriteString(W, " (NIL check)")
  213.                                 ELSE 
  214.                                     Texts.WriteString(W, " (HALT("); Texts.WriteInt(W, p, 0); Texts.WriteString(W, ") called)")
  215.                                 END
  216.                             END
  217.                     |   3: Texts.WriteString(W, " (Failed memory access)")
  218.                     |   4: Texts.WriteString(W, " (Unmapped memory)")
  219.                     |   5: Texts.WriteString(W, " (Excluded memory)")
  220.                     |   6: Texts.WriteString(W, " (Read only memory)")
  221.                     |   7: Texts.WriteString(W, " (Page fault)")
  222.                     |   8: Texts.WriteString(W, " (Privilege violation)")
  223.                     | 10: Texts.WriteString(W, " (Instruction breakpoint)")
  224.                     | 11: Texts.WriteString(W, " (Data breakpoint)")
  225.                     | 12: Texts.WriteString(W, " (Unused)")
  226.                     | 13: Texts.WriteString(W, " (Floating point)")
  227.                     | 14: Texts.WriteString(W, " (Stack overflow)")
  228.                     | 15: Texts.WriteString(W, " (Task terminated)")
  229.                     ELSE
  230.                     END
  231.                 END;
  232.                 Texts.WriteLn(W); Texts.Append(T, W.buf);
  233.                 nofFrames := 0; first := TRUE;
  234.                 stackBottom := Kernel.resumeSP;
  235.                 WHILE (sp <= stackBottom) & (nofFrames < 64) DO
  236.                     FindProc(pc, mod, ref, refend);
  237.                     IF mod # NIL THEN
  238.                         Texts.WriteString(W, mod^.name);
  239.                         IF ref > 0 THEN
  240.                             ReadInt(fsize, ref); ReadInt(psize, ref); ReadInt(ralloc, ref); ReadInt(falloc, ref); ReadInt(calloc, ref);
  241.                             SYSTEM.GET(ref, leaf); INC(ref);
  242.                             Texts.Write(W, ".");
  243.                             SYSTEM.GET(ref, ch); INC(ref); body := ch = "$";
  244.                             WHILE (ch # 0X) & (ref < refend) DO
  245.                                 Texts.Write(W, ch); SYSTEM.GET(ref, ch); INC(ref)
  246.                             END;
  247.                             Texts.Write(W, " ");
  248.                             IF first THEN Texts.WriteHex(W, pc-mod^.PC); first := FALSE
  249.                             ELSE Texts.WriteHex(W, pc-mod^.PC-4)
  250.                             END;
  251.                             Texts.Write(W, "H");
  252.                             IF body THEN p := mod^.SB ELSE p := cur.reg.R[31*2+1] END;
  253.                             Locals(cur, ref, refend, p);
  254.                             SYSTEM.GET(sp, sp);
  255.                             IF leaf THEN pc := cur.spec.LR ELSE SYSTEM.GET(sp+8, pc) END;
  256.                             p := sp-(31-ralloc)*4;
  257.                             WHILE ralloc < 31 DO INC(ralloc); SYSTEM.GET(p, cur.reg.R[2*ralloc+1]); INC(p, 4) END;
  258.                             INC(p, (-p) MOD 8);
  259.                             WHILE falloc < 31 DO INC(falloc); SYSTEM.GET(p, cur.fp.R[2*falloc+1]); INC(p, 8) END;
  260.                             IF calloc < 19 THEN SYSTEM.GET(sp+4, cur.spec.CR) END
  261.                         ELSE
  262.                             SYSTEM.GET(sp, sp); SYSTEM.GET(sp+8, pc)
  263.                         END
  264.                     ELSE
  265.                         Texts.WriteString(W, "unknown procedure ");
  266.                         Texts.WriteHex(W, pc); Texts.Write(W, "H"); Texts.WriteLn(W);
  267.                         Texts.Append(T, W.buf); DEC(trap);
  268.                         Kernel.Resume (info);
  269.                         RETURN 0
  270.                     END;
  271.                     Texts.Append(T, W.buf); INC(nofFrames)
  272.                 END
  273.             END
  274.         END;
  275.         DEC(trap);
  276.         Kernel.Resume (info);
  277.         RETURN 0;
  278.     END Trap;
  279.     PROCEDURE Max (i, j: LONGINT): LONGINT;
  280.     BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
  281.     END Max;
  282.     PROCEDURE Open*;
  283.         VAR par: Oberon.ParList;
  284.             T: Texts.Text;
  285.             S: Texts.Scanner;
  286.             V: Viewers.Viewer;
  287.             X, Y: INTEGER;
  288.             beg, end, time: LONGINT;
  289.     BEGIN
  290.         par := Oberon.Par;
  291.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  292.         IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
  293.             Oberon.GetSelection(T, beg, end, time);
  294.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  295.         END;
  296.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  297.             Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
  298.             V := MenuViewers.New(
  299.               TextFrames.NewMenu(S.s, "^System.Menu.Text"),
  300.               TextFrames.NewText(TextFrames.Text(S.s), 0),
  301.               TextFrames.menuH,
  302.               X, Y)
  303.         END
  304.     END Open;
  305.     PROCEDURE OpenLog*;
  306.       VAR logV: Viewers.Viewer; X, Y: INTEGER;
  307.     BEGIN
  308.         Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  309.         logV := MenuViewers.New(
  310.           TextFrames.NewMenu("System.Log", "^Log.Menu.Text"),
  311.           TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)),
  312.           TextFrames.menuH,
  313.           X, Y)
  314.     END OpenLog;
  315.     PROCEDURE ClearLog*;
  316.     BEGIN Texts.Delete(Oberon.Log, 0, Oberon.Log.len)
  317.     END ClearLog;
  318.     PROCEDURE Close*;
  319.         VAR par: Oberon.ParList; V: Viewers.Viewer;
  320.     BEGIN
  321.         par := Oberon.Par;
  322.         IF par.frame = par.vwr.dsc THEN V := par.vwr
  323.         ELSE V := Oberon.MarkedViewer()
  324.         END;
  325.         Viewers.Close(V)
  326.     END Close;
  327.     PROCEDURE CloseTrack*;
  328.       VAR V: Viewers.Viewer;
  329.     BEGIN V := Oberon.MarkedViewer(); Viewers.CloseTrack(V.X)
  330.     END CloseTrack;
  331.     PROCEDURE Recall*;
  332.       VAR V: Viewers.Viewer; M: Viewers.ViewerMsg;
  333.     BEGIN
  334.       Viewers.Recall(V);
  335.       IF (V # NIL) & (V.state = 0) THEN
  336.         Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M)
  337.       END
  338.     END Recall;
  339.     PROCEDURE Copy*;
  340.         VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
  341.     BEGIN
  342.         V := Oberon.Par.vwr; V.handle(V, M); V1 := M.F(Viewers.Viewer);
  343.         Viewers.Open(V1, V.X, V.Y + V.H DIV 2);
  344.         N.id := Viewers.restore; V1.handle(V1, N)
  345.     END Copy;
  346.     PROCEDURE Grow*;
  347.         VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
  348.           DW, DH: INTEGER;
  349.     BEGIN V := Oberon.Par.vwr;
  350.         DW := Oberon.DisplayWidth(V.X); DH := Oberon.DisplayHeight(V.X);
  351.         IF V.H < DH - Viewers.minH THEN Oberon.OpenTrack(V.X, V.W)
  352.           ELSIF V.W < DW THEN Oberon.OpenTrack(Oberon.UserTrack(V.X), DW)
  353.         END;
  354.         IF (V.H < DH - Viewers.minH) OR (V.W < DW) THEN
  355.           V.handle(V, M); V1 := M.F(Viewers.Viewer);
  356.           Viewers.Open(V1, V.X, DH);
  357.           N.id := Viewers.restore; V1.handle(V1, N)
  358.        END
  359.     END Grow;
  360.     PROCEDURE GetArg (VAR S: Texts.Scanner);
  361.         VAR T: Texts.Text; beg, end, time: LONGINT;
  362.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  363.         IF (S.class = Texts.Char) & (S.c = "^") THEN
  364.             Oberon.GetSelection(T, beg, end, time);
  365.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  366.         END
  367.     END GetArg;
  368.     PROCEDURE EndLine;
  369.     BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  370.     END EndLine;
  371.     PROCEDURE SetFont*;
  372.         VAR S: Texts.Scanner;
  373.     BEGIN GetArg(S);
  374.         IF S.class = Texts.Name THEN Oberon.SetFont(Fonts.This(S.s)) END
  375.     END SetFont;
  376.     PROCEDURE SetColor*;
  377.         VAR S: Texts.Scanner;
  378.     BEGIN GetArg(S);
  379.         IF S.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(S.i))) END
  380.     END SetColor;
  381.     PROCEDURE SetOffset*;
  382.         VAR S: Texts.Scanner;
  383.     BEGIN GetArg(S);
  384.         IF S.class = Texts.Int THEN Oberon.SetOffset(SHORT(SHORT(S.i))) END
  385.     END SetOffset;
  386.     PROCEDURE Time*;
  387.         VAR t, d: LONGINT;
  388.     BEGIN
  389.         Texts.WriteString(W, "System.Time");
  390.         Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); Texts.WriteLn(W);
  391.         Texts.Append(Oberon.Log, W.buf)
  392.     END Time;
  393.     PROCEDURE AboutOberon*;
  394.     BEGIN    Macintosh.AboutOberon
  395.     END AboutOberon;
  396.     PROCEDURE Watch*;
  397.         VAR avail: LONGINT;
  398.     BEGIN
  399.         Texts.WriteString(W, "System.Watch"); Texts.WriteLn(W);
  400.         Texts.WriteString(W, "heap size: "); Texts.WriteInt(W, Kernel.heapEnd-Kernel.heapBeg, 0); Texts.WriteString(W, " bytes"); Texts.WriteLn(W);
  401.         avail := Kernel.Available();
  402.         Texts.WriteString(W, "allocated: "); Texts.WriteInt(W, Kernel.heapEnd - Kernel.heapBeg - avail, 0); Texts.WriteLn(W);
  403.         Texts.WriteString(W, "available: "); Texts.WriteInt(W, avail, 0); Texts.WriteLn(W);
  404.         Texts.WriteString(W, "largest free block: "); Texts.WriteInt(W, Kernel.LargestAvailable(), 0); Texts.WriteLn(W);
  405.         Texts.Append(Oberon.Log, W.buf)
  406.     END Watch;
  407.     PROCEDURE Collect*;
  408.     BEGIN Oberon.Collect(0)
  409.     END Collect;
  410.     PROCEDURE FreeMod (VAR S: Texts.Scanner);
  411.     BEGIN
  412.         Texts.WriteString(W, S.s); Texts.WriteString(W, " unloading");
  413.         Texts.Append(Oberon.Log, W.buf);
  414.         IF S.nextCh # "*" THEN Modules.Free(S.s, FALSE)
  415.             ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Texts.WriteString(W, " all")
  416.         END;
  417.         IF Modules.res # 0 THEN Texts.WriteString(W, " failed") END;
  418.         Texts.WriteLn(W);
  419.         Texts.Append(Oberon.Log, W.buf)
  420.     END FreeMod;
  421.     PROCEDURE Free*;
  422.         VAR par: Oberon.ParList;
  423.             T: Texts.Text;
  424.             S: Texts.Scanner;
  425.             beg, end, time: LONGINT;
  426.     BEGIN
  427.         par := Oberon.Par;
  428.         Texts.WriteString(W, "System.Free"); Texts.WriteLn(W);
  429.         Texts.Append(Oberon.Log, W.buf);
  430.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  431.         WHILE S.class = Texts.Name DO FreeMod(S); Texts.Scan(S) END;
  432.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  433.           IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
  434.             IF S.class = Texts.Name THEN FreeMod(S) END
  435.           END
  436.         END
  437.     END Free;
  438.     PROCEDURE ShowModules*;
  439.         VAR T: Texts.Text;
  440.             V: Viewers.Viewer;
  441.             M: Modules.Module;
  442.             X, Y, i: INTEGER;
  443.     BEGIN
  444.         T := TextFrames.Text("");
  445.         Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  446.         V := MenuViewers.New(
  447.           TextFrames.NewMenu("System.ShowModules", "System.Close System.Copy System.Grow System.Free ^ Edit.Store "),
  448.           TextFrames.NewText(T, 0),
  449.           TextFrames.menuH,
  450.           X, Y);
  451.         M := Modules.modules;
  452.         WHILE M # NIL DO
  453.             Texts.WriteString(W, M.name);
  454.             i := 0; WHILE M.name[i] # 0X DO INC(i) END ;
  455.             i := 32-i; WHILE i > 0 DO Texts.Write(W, " "); DEC(i) END ;
  456.             Texts.WriteString(W, "codesize = ");
  457.             Texts.WriteInt(W, M.codesize, 5);
  458.             Texts.WriteString(W, "  PC = "); Texts.WriteHex(W, M.PC);
  459.             Texts.WriteString(W, "H  SB =  ");  Texts.WriteHex(W, M.SB);
  460.             Texts.WriteString(W, "H  ");
  461.             Texts.WriteString(W, "refcnt =  ");  Texts.WriteInt(W, M.refcnt, 0); Texts.WriteLn(W);
  462.             M := M.link
  463.         END;
  464.         Texts.Append(T, W.buf)
  465.     END ShowModules;
  466.     PROCEDURE ShowCommands*;
  467.         VAR
  468.             M: Modules.Module; S: Texts.Scanner; beg, end, time, i, len: LONGINT;
  469.             T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER; cmd: Modules.CommandPtr;
  470.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  471.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  472.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END ;
  473.         END ;
  474.         IF S.class = Texts.Name THEN
  475.             i := 0; WHILE S.s[i] >= "0" DO INC(i) END ;
  476.             S.s[i] := 0X; M := Modules.ThisMod(S.s);
  477.             IF M # NIL THEN i := 0; len := 0;
  478.                 IF M^.commands # 0 THEN len := M^.nofcmds END;
  479.                 Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  480.                 T := TextFrames.Text("");
  481.                 V := MenuViewers.New(
  482.                     TextFrames.NewMenu("System.Commands", "^System.Menu.Text"),
  483.                     TextFrames.NewText(T, 0),
  484.                     TextFrames.menuH,
  485.                     X, Y);
  486.                 cmd := SYSTEM.VAL (Modules.CommandPtr, M.commands);
  487.                 WHILE i < len DO
  488.                     Texts.WriteString(W, M.name); Texts.Write(W, ".");
  489.                     Texts.WriteString(W, cmd.name); Texts.WriteLn(W);
  490.                     cmd := SYSTEM.VAL (Modules.CommandPtr, SYSTEM.VAL (LONGINT, cmd)+26);
  491.                     INC(i)
  492.                 END ;
  493.                 Texts.Append(T, W.buf)
  494.             END
  495.         END
  496.     END ShowCommands;
  497.     PROCEDURE State*;
  498.         VAR par: Oberon.ParList;
  499.             t, T: Texts.Text;
  500.             S: Texts.Scanner;
  501.             V: Viewers.Viewer;
  502.             mod: Modules.Module;
  503.             X, Y: INTEGER;
  504.             beg, end, time, ref, refend, p: LONGINT; 
  505.             info: Sys.ExceptionInfoDesc;
  506.             ch: CHAR;
  507.     BEGIN par := Oberon.Par;
  508.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  509.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  510.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END ;
  511.         END ;
  512.        Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
  513.         t := TextFrames.Text("");
  514.         V := MenuViewers.New(
  515.           TextFrames.NewMenu("System.State", "^System.Menu.Text"),
  516.           TextFrames.NewText(t, 0),
  517.           TextFrames.menuH,
  518.           X, Y);
  519.         WHILE S.class = Texts.Name DO
  520.             p := 0; WHILE (p < LEN(S.s)) & (S.s[p] # 0X) & (S.s[p] # ".") DO INC(p) END;
  521.             IF S.s[p] = "." THEN S.s[p] := 0X END;
  522.             Texts.WriteString(W, S.s); mod := Modules.modules;
  523.             WHILE (mod # NIL) & (mod.name # S.s) DO mod := mod.link END;
  524.             IF mod # NIL THEN
  525.                 Texts.WriteString(W, " SB = "); Texts.WriteHex(W, mod.SB); Texts.Write(W, "H");
  526.                 ref := mod^.refs; refend := ref;
  527.                 IF mod^.refs # 0 THEN INC(refend, mod^.refsize) END;
  528.                 LOOP
  529.                     IF ref >= refend THEN EXIT END;
  530.                     SYSTEM.GET(ref, ch); INC(ref);
  531.                     IF ch = 0F8X THEN
  532.                         ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref); ReadInt(p, ref);
  533.                         SYSTEM.GET(ref, ch); INC(ref);
  534.                         SYSTEM.GET(ref, ch); INC(ref);
  535.                         IF ch = "$" THEN EXIT END
  536.                     END
  537.                 END;
  538.                 IF (ref < refend) & (ch = "$") THEN
  539.                     INC(ref, 2); Locals(info, ref, refend, mod^.SB)
  540.                 END;
  541.                 Texts.WriteLn(W); Texts.Append(t, W.buf)
  542.             ELSE
  543.                 Texts.WriteString(W, " not loaded"); Texts.WriteLn(W); Texts.Append(t, W.buf)
  544.             END;
  545.             Texts.Scan(S)
  546.         END
  547.     END State;
  548.     PROCEDURE SetUser*;
  549.         VAR i: INTEGER; ch: CHAR;
  550.             user: ARRAY 8 OF CHAR;
  551.             password: ARRAY 16 OF CHAR;
  552.     BEGIN
  553.         i := 0; Input.Read(ch);
  554.         WHILE (ch # "/") & (i < 7) DO user[i] := ch; INC(i); Input.Read(ch) END;
  555.         user[i] := 0X;
  556.         i := 0; Input.Read(ch);
  557.         WHILE (ch > " ") & (i < 15) DO password[i] := ch; INC(i); Input.Read(ch) END;
  558.         password[i] := 0X;
  559.         Oberon.SetUser(user, password)
  560.     END SetUser;
  561.     PROCEDURE CopyFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
  562.         VAR f, g: Files.File; Rf, Rg: Files.Rider; ch: CHAR;
  563.     BEGIN Texts.Scan(S);
  564.         IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
  565.             IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
  566.                 IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  567.                     Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s);
  568.                     Texts.WriteString(W, " copying"); Texts.Append(Oberon.Log, W.buf);
  569.                     f := Files.Old(name);
  570.                     IF f # NIL THEN g := Files.New(S.s);
  571.                         Files.Set(Rf, f, 0); Files.Set(Rg, g, 0); Files.Read(Rf, ch);
  572.                         WHILE ~Rf.eof DO Files.Write(Rg, ch); Files.Read(Rf, ch) END;
  573.                         Files.Register(g)
  574.                     ELSE Texts.WriteString(W, " failed")
  575.                     END ;
  576.                     EndLine
  577.                 END
  578.             END
  579.         END
  580.     END CopyFile;
  581.     PROCEDURE CopyFiles*;
  582.         VAR S: Texts.Scanner;
  583.     BEGIN GetArg(S);
  584.         Texts.WriteString(W, "System.CopyFiles"); EndLine;
  585.         WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO CopyFile(S.s, S); Texts.Scan(S) END
  586.     END CopyFiles;
  587.     PROCEDURE RenameFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
  588.         VAR res: INTEGER;
  589.     BEGIN Texts.Scan(S);
  590.         IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
  591.             IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
  592.                 IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  593.                     Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s);
  594.                     Texts.WriteString(W, " renaming"); Files.Rename(name, S.s, res);
  595.                     IF res > 1 THEN Texts.WriteString(W, " failed") END;
  596.                     EndLine
  597.                 END
  598.             END
  599.         END
  600.     END RenameFile;
  601.     PROCEDURE RenameFiles*;
  602.         VAR S: Texts.Scanner;
  603.     BEGIN GetArg(S);
  604.         Texts.WriteString(W, "System.RenameFiles"); EndLine;
  605.         WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO RenameFile(S.s, S); Texts.Scan(S) END
  606.     END RenameFiles;
  607.     PROCEDURE DeleteFile(VAR name: ARRAY OF CHAR);
  608.         VAR res: INTEGER;
  609.     BEGIN Texts.WriteString(W, name); Texts.WriteString(W, " deleting");
  610.         Files.Delete(name, res);
  611.         IF res # 0 THEN Texts.WriteString(W, " failed") END;
  612.         EndLine
  613.     END DeleteFile;
  614.     PROCEDURE DeleteFiles*;
  615.         VAR S: Texts.Scanner;
  616.     BEGIN GetArg(S);
  617.         Texts.WriteString(W, "System.DeleteFiles"); EndLine;
  618.         WHILE (S.class = Texts.Name) OR (S.class = Texts.String) DO DeleteFile(S.s); Texts.Scan(S) END
  619.     END DeleteFiles;
  620.     PROCEDURE HasSpace (VAR str: ARRAY OF CHAR) : BOOLEAN;
  621.     VAR i: INTEGER;
  622.     BEGIN i := 0; WHILE (str[i] # 0X) & (str[i] # ' ') DO INC (i) END; RETURN str[i] = ' '
  623.     END HasSpace;
  624.     PROCEDURE ShowFile (d: Directories.Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN);
  625.         VAR path: ARRAY 256 OF CHAR; time, date, size: LONGINT; f: Files.File;
  626.     BEGIN
  627.         IF Strings.Match(name, pattern) THEN
  628.             COPY(d.path, path); Strings.Append(":", path); Strings.Append(name, path);
  629.             IF allPaths IN options THEN 
  630.                 IF HasSpace (path) THEN Texts.Write (W, '"') END;
  631.                 Texts.WriteString(W, path);
  632.                 IF HasSpace (path) THEN Texts.Write (W, '"') END
  633.             ELSIF fullPath THEN
  634.                 IF HasSpace (path) THEN Texts.Write (W, '"') END;
  635.                 Texts.WriteString(W, d.path);
  636.                 Texts.WriteString (W, name);
  637.                 IF isDir THEN Texts.Write (W, ':'); Texts.WriteString (W, pattern) END;
  638.                 IF HasSpace (path) THEN Texts.Write (W, '"') END
  639.             ELSIF isDir THEN 
  640.                 IF HasSpace (name) THEN Texts.Write (W, '"') END;
  641.                 Texts.Write(W, ":"); Texts.WriteString(W, name);
  642.                 IF HasSpace (name) THEN Texts.Write (W, '"') END
  643.             ELSE 
  644.                 IF HasSpace (name) THEN Texts.Write (W, '"') END;
  645.                 Texts.WriteString(W, name);
  646.                 IF HasSpace (name) THEN Texts.Write (W, '"') END
  647.             END;
  648.             IF ({dateOpt, sizeOpt} * options # {}) & ~isDir THEN
  649.                 f := Files.Old (path); ASSERT (f # NIL);
  650.                 Files.GetDate (f, time, date); size := Files.Length (f);
  651.                 Files.Close (f);
  652.                 IF dateOpt IN options THEN Texts.WriteString(W, "  "); Texts.WriteDate(W, time, date) END;
  653.                 IF sizeOpt IN options THEN Texts.WriteInt(W, size, 8) END
  654.             END;
  655.             Texts.WriteLn(W); Texts.Append(T, W.buf)
  656.         END
  657.     END ShowFile;
  658.     PROCEDURE ScanDirectory (path: ARRAY OF CHAR; VAR continue: BOOLEAN);
  659.         VAR d, cur, startup: Directories.Directory;
  660.     BEGIN
  661.         d := Directories.This(path); cur := Directories.Current(); startup := Directories.Startup();
  662.         IF (d # NIL) & (d.path # cur.path) & (d.path # startup.path) THEN
  663.             Directories.Enumerate(d, ShowFile);
  664.             IF d.path = startup.path THEN startupDone := TRUE END
  665.         END
  666.     END ScanDirectory;
  667.     PROCEDURE Directory*;
  668.         VAR R: Texts.Reader; 
  669.             t: Texts.Text; V: Viewers.Viewer; 
  670.             beg, end, time: LONGINT;
  671.             X, Y, i, len: INTEGER; c, ch: CHAR;
  672.             dir, startup: Directories.Directory;
  673.     BEGIN
  674.         Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos); Texts.Read(R, ch);
  675.         WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END;
  676.         IF ch = "^" THEN Oberon.GetSelection(t, beg, end, time);
  677.             IF time >= 0 THEN Texts.OpenReader(R, t, beg); Texts.Read(R, ch);
  678.                 WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END
  679.             END
  680.         END;
  681.         i := 0;
  682.         IF (ch = "'") OR (ch = '"') THEN
  683.             c := ch; Texts.Read(R, ch);
  684.             WHILE (ch # c) & (ch >= " ") & ~R.eot DO pattern[i]:=ch; INC(i); Texts.Read(R, ch) END;
  685.             Texts.Read(R, ch)
  686.         ELSIF (ch > " ") & (ch # "/") & (ch # "^") THEN
  687.             WHILE (ch > " ") & (ch # "/") DO pattern[i]:=ch; INC(i); Texts.Read(R, ch) END;
  688.         END;
  689.         pattern[i] := 0X;
  690.         options := {};
  691.         WHILE ((ch = " ") OR (ch = 09X)) & ~R.eot DO Texts.Read(R, ch) END;
  692.         IF ch = "/" THEN
  693.             LOOP Texts.Read(R, ch);
  694.                 IF ch = "d" THEN INCL(options, dateOpt) 
  695.                 ELSIF ch = "s" THEN INCL(options, sizeOpt) 
  696.                 ELSIF ch = "a" THEN INCL(options, allPaths)
  697.                 ELSE EXIT END
  698.             END
  699.         END;
  700.         IF pattern = "" THEN RETURN END;
  701.         T := TextFrames.Text(""); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  702.         V := MenuViewers.New(TextFrames.NewMenu("System.Directory", "^System.Menu.Text"), TextFrames.NewText(T, 0), 
  703.             TextFrames.menuH, X, Y);
  704.         startup := Directories.Startup ();
  705.         len := Strings.Length (pattern);
  706.         REPEAT DEC (len) UNTIL (len = -1) OR (pattern[len] = Directories.delimiter);
  707.         fullPath := len # -1;
  708.         IF len = -1 THEN
  709.             dir := Directories.Current ()
  710.         ELSE
  711.             ch := pattern[len+1];
  712.             pattern[len+1] := 0X; dir := Directories.This (pattern);
  713.             pattern[len+1] := ch;
  714.             i := 0;
  715.             REPEAT
  716.                 INC (len);
  717.                 pattern[i] := pattern[len]; INC (i)
  718.             UNTIL pattern[i] = 0X
  719.         END;
  720.         Directories.Enumerate(dir, ShowFile);
  721.         startupDone := dir.path = startup.path;
  722.         IF allPaths IN options THEN
  723.             Directories.EnumeratePaths(ScanDirectory);
  724.             IF ~startupDone THEN Directories.Enumerate(startup, ShowFile) END
  725.         END
  726.     END Directory;
  727.     PROCEDURE ChangeDir*;
  728.         VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT;
  729.     BEGIN
  730.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  731.         IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
  732.             Oberon.GetSelection(T, beg, end, time);
  733.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  734.         END;
  735.         IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
  736.             Texts.WriteString(W, S.s);
  737.             Directories.Change(S.s);
  738.             IF Directories.res # 0 THEN Texts.WriteString(W, "  -- failed") END;
  739.             Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  740.         END
  741.     END ChangeDir; 
  742.     PROCEDURE CreateDir*;
  743.         VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT; d: Directories.Directory;
  744.     BEGIN
  745.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  746.         IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
  747.             Oberon.GetSelection(T, beg, end, time);
  748.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  749.         END;
  750.         IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
  751.             Texts.WriteString(W, "System.CreateDir "); Texts.WriteString(W, S.s);
  752.             Directories.Create(S.s);
  753.             d := Directories.This(S.s);
  754.             IF Directories.res # Directories.noErr THEN Texts.WriteString(W, " failed") END;
  755.             Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
  756.         END
  757.     END CreateDir;
  758.     PROCEDURE DeleteDir*;
  759.         VAR T: Texts.Text; S: Texts.Scanner; res: INTEGER; beg, end, time: LONGINT; d: Directories.Directory;
  760.     BEGIN
  761.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  762.         IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
  763.             Oberon.GetSelection(T, beg, end, time);
  764.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  765.         END;
  766.         IF ((S.class = Texts.Name) OR (S.class = Texts.String)) & (S.line = 0) THEN
  767.             Texts.WriteString(W, "System.DeleteDir "); Texts.WriteString(W, S.s);
  768.             Directories.Delete(S.s);
  769.             IF Directories.res # Directories.noErr THEN Texts.WriteString(W, " failed") END;
  770.             Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
  771.         END
  772.     END DeleteDir;
  773.     PROCEDURE HomeDir*;
  774.         VAR d: Directories.Directory;
  775.     BEGIN
  776.         d := Directories.Startup();
  777.         Directories.Change (d.path);
  778.         Texts.WriteString(W, d.path); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  779.     END HomeDir;
  780.     PROCEDURE ShowDir*;
  781.         VAR d: Directories.Directory;
  782.     BEGIN
  783.         d := Directories.Current();
  784.         Texts.WriteString(W, d.path); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  785.     END ShowDir;
  786.     PROCEDURE ParentDir*;
  787.         VAR d: Directories.Directory;
  788.     BEGIN
  789.         Directories.Change("::");
  790.         IF Directories.res # 0 THEN 
  791.             Texts.WriteString(W, "::  -- failed")
  792.         ELSE
  793.             d := Directories.Current();
  794.             Texts.WriteString(W, d.path)
  795.         END;
  796.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  797.     END ParentDir;
  798.     PROCEDURE Quit*;
  799.     BEGIN
  800.         Kernel.FinalizeAll;
  801.         Kernel.quitQ.Handle;
  802.         Sys.ExitToShell;
  803.     END Quit;
  804.     PROCEDURE Init;
  805.     BEGIN
  806.         trap := 0;
  807.         OldTrap := Sys.InstallExceptionHandler (Trap);
  808.     END Init;
  809.     PROCEDURE OpenStandard;
  810.         VAR X, Y: INTEGER; logV, toolV: Viewers.Viewer;
  811.     BEGIN
  812.         Oberon.AllocateSystemViewer(0, X, Y);
  813.         logV := MenuViewers.New(
  814.             TextFrames.NewMenu("System.Log", "^Log.Menu.Text"),
  815.             TextFrames.NewText(Oberon.Log, 0),
  816.             TextFrames.menuH,
  817.             X, Y);
  818.         Oberon.AllocateSystemViewer(0, X, Y);
  819.         toolV := MenuViewers.New(
  820.             TextFrames.NewMenu("System.Tool", "^System.Menu.Text"),
  821.             TextFrames.NewText(TextFrames.Text("System.Tool"), 0),
  822.             TextFrames.menuH,
  823.             X, Y)
  824.     END OpenStandard;
  825. BEGIN
  826.     Texts.OpenWriter(W);
  827.     Init;
  828.     Oberon.Log := TextFrames.Text("");
  829.     Oberon.GetClock(t, d);
  830.     Texts.WriteString(W, VersionString);
  831.     Texts.WriteDate(W, t, d); Texts.WriteLn(W);
  832.     Texts.Append(Oberon.Log, W.buf); 
  833.     IF Modules.ThisMod("Configuration") = NIL THEN OpenStandard END
  834. END System.
  835.